' Stack, List, Queue and String Manipulation Routines
' Doug Pankhurst 2013
'---------------------------------------------------------------
'Stack Manipulation Routines
' - impliments a LIFO push down stack within a single string
'   variable using up to 250 character positions in that string.
'   The string name is the stack name.

'Subroutine to create an n wide x n deep stack using a single
' string variable. n x n must be equal or smaller than 250
' Enter with stk_name$ as the name of the stack with stk_width
' as the element width (max 99 char wide). eg. 1 wide x 250 deep,
' 5 wide x 50 deep, 10 wide x 25 deep etc.
Sub S.Stack.Create stk_name$,stk_width
Local stk_n$,stk_w,stk_e
stk_n$ = stk_name$
stk_w = stk_width
If stk_w  =< 250 Then
  stk_n$=Format$(stk_w,"%02g")+Format$(6,"%03g")
Else
  Print "Error - Stack too big - maximum width by depth =<250"
  Exit Sub
EndIf
stk_name$ = stk_n$
End Sub
'The string used returns with the stack width in the first 2
' character positions and a pointer to the next stack entry
' position in the 3rd 4th and 5th character positions.
' To be used, they need to be converted back to numbers.

' Subroutine to push a new value onto the stack
' Enter with stack string name and value to be pushed
Sub S.Stack.Push stk_name$,stk_data$
Local stk_n$,stk_w,stk_ptr,stk_body$
stk_n$ = stk_name$
stk_d$ = stk_data$
stk_w = Val(Mid$(stk_n$,1,2))              'extract width
stk_ptr = Val(Mid$(stk_n$,3,3))            ' pointer to bottom+1
If stk_ptr < 256 Then
  If stk_ptr - 6 = 0 Then
    stk_body$ = ""
  Else
    stk_body$ = Mid$(stk_name$,6,stk_ptr-stk_w)
  EndIf
  If Len(stk_d$) > stk_w Then     'check new stack data width
    Print "Error - Data wider than stack width"
    Exit Sub
  Else                              ' pad if needed
    stk_body$ = stk_d$ + Space$(stk_w - Len(stk_d$)) + stk_body$
  EndIf
  stk_ptr = stk_ptr+ stk_w          ' update pointer and merge all
  stk_n$ = Format$(stk_w,"%02g") + Format$(stk_ptr,"%03g") + stk_body$
Else
  Print "Error - Stack overflow"
  Exit Sub
EndIf
stk_name$ = stk_n$
End Sub
' Return with stack string updated

' Funtion to pop a value off the top of the stack
' Enter with stack string name
Function S.Stack.Pop$(stk_name$)
Local stk_n$,stk_w,stk_ptr,stk_body$
stk_n$ = stk_name$
stk_w = Val(Mid$(stk_n$,1,2))      'extract width
stk_ptr = Val(Mid$(stk_n$,3,3))    ' pointer to bottom+1
If stk_ptr => 6 + stk_w Then
  stk_body$ = Mid$(stk_n$,6 + stk_w,stk_ptr-1)
  S.Stack.Pop$ = Mid$(stk_n$,6,stk_w)
  stk_ptr = stk_ptr - stk_w
  stk_n$ = Format$(stk_w,"%02g") + Format$(stk_ptr,"%03g") + stk_body$
Else
  Print "Error - Stack underflow"
  Exit Function
EndIf
stk_name$ = stk_n$
End Function
' Return top element of stack

'------------------------------
' List Manipulation Routines
' Impliments an n width (up to 99 characters) list of multiple entries which can be
' recalled with an index number. Lists must be less than 250 characters
' in total. ie. 25 list entries of 10 characters etc.

' Subroutine to create an empty list with list element
' width in positions 1 and 2 and index pointer in positions 3, 4 and 5
Sub S.List.Create lst_name$,lst_width
Local lst_n$,lst_w
lst_n$ = lst_name$
lst_w = lst_width
If lst_w =< 250 Then
  lst_n$=Format$(lst_w,"%02g")+Format$(1,"%03g")
Else
  Print "Error - maximum width by number of entries must be =< 250"
  Exit Sub
EndIf
lst_name$ = lst_n$
End Sub

' Subroutine to add a single entry to end of list
Sub S.List.Add lst_name$,lst_data$
Local lst_n$,lst_w,lst_ptr,lst_body$,lst_d$
lst_n$ = lst_name$
lst_d$ = lst_data$
lst_w = Val(Mid$(lst_n$,1,2))
lst_ptr = Val(Mid$(lst_n$,3,3))
lst_body$ = Mid$(lst_n$,6,lst_ptr * lst_w)
If Len(lst_d$) > lst_w Then     'check new lst data width
  Print "Error - list entry too wide"
  Exit Sub
Else                              ' pad if needed
  lst_d$ =  lst_d$ + Space$(lst_w - Len(lst_d$))
EndIf
If (lst_ptr * lst_w) + lst_w < 250 Then
  lst_body$ = lst_body$ + lst_d$
  lst_ptr = lst_ptr + 1
  lst_n$ = Format$(lst_w,"%02g") + Format$(lst_ptr,"%03g") + lst_body$
Else
  Print "Error - list overflow - too many entries"
EndIf
lst_name$ = lst_n$
End Sub

' Subroutine to create and fill a list from a file that contains
' the list data in the format of characters up to list_width
' plus CRLF. CRLF is stripped before data is inserted in list.
Sub S.List.Fill lst_name$,lst_width,lst_file$
Local lst_n$,lst_w,lst_body$,lst_f$,chr_cnt,lst_d$
lst_n$ = lst_name$
lst_w = lst_width
lst_f$ = lst_file$
chr_cnt = 0
S.List.Create lst_n$,lst_w
Open lst_f$ For Input As #1
Do While Not Eof(#1)
  lst_d$ = ""
  Line Input #1,lst_d$
  lst_d$ = Left$(lst_d$,Len(lst_d$ - 2)
  If Len(lst_d$) > lst_w Then
    Print "List element too long"
    Exit Sub
  ElseIf Len(lst_d$) < lst_w Then
    lst_d$ = lst_d$ + Space$(lst_w - Len(lst_d$))
  EndIf
  chr_cnt = chr_cnt + Len(lst_d$)
  If chr_cnt < 251 Then
    S.List.Add lst_n$,lst_d$
  Else
    Print "Error - List file overflow"
    Exit Sub
  EndIf
Loop
lst_name$ = lst_n$
End Sub

' Function to return a list entry
' - enter with list entry number as index
Function S.List.Get$(lst_name$,lst_ptr)
Local lst_n$,lst_w
lst_n$ = lst_name$
If lst_ptr > Val(Mid$(lst_n$,3,3)) Then
  Print "Error - list index out of range"
  Exit Function
EndIf
lst_w = Val(Mid$(lst_n$,1,2))  'get list entry width
S.List.Get$ = Mid$(lst_n$,6 + ((lst_ptr*lst_w) - lst_w),lst_w)
End Function

' Function to test for and select an error msg from a supplied list
' which must be of the format of the list created and filled with the
' List.Create and List.Add or List.Fill routines
' - returns error message
Function S.Err.Check$(err_list$,err_no)
If err_no <> 0 Then
  S.Err.Check$ = S.List.Get$(err_list$,err_no)
Else
  S.Err.Check$ = ""
EndIf
End Function

'------------------------------
' Queue Manipulation Routines
' Impliments a FIFO asynchronous n wide x n deep queue using a
' single string variable. n x n must be equal to or less than 250
' Elements can be pushed into or pulled off the queue asynchronously.

'Subroutine to create an n wide x n deep queue using a single
' string variable. n x n must be equal or smaller than 250
' Enter with queue_name$ as the name of the queue with queue_width
' as the element width (max 99 char wide). eg. 1 wide x 250 deep,
' 5 wide x 50 deep, 10 wide x 25 deep etc.
Sub S.Queue.Create queue_name$,queue_width
Local que_n$,que_w
que_n$ = queue_name$
que_w = queue_width
If que_w  =< 250 Then
  que_n$=Format$(que_w,"%02g")+Format$(6,"%03g")
Else
  Print "Error - Queue too big - maximum width by depth =< 250"
  Exit Sub
EndIf
queue_name$ = que_n$
End Sub
'The string used returns with the queue width in the first 2
' character positions and a pointer to the end of the queue
' position in the 3rd 4th and 5th character positions.
' To be used, they need to be converted back to numbers.

' Subroutine to push a new value onto the back of the queue
' - queue back is the position starting as position 6 of the string,
' queue front is the bottom of the string. All new entries are pushed
' further into the string with each push.
' Enter with queue string name and value to be pushed
Sub S.Queue.Push queue_name$,queue_data$
Local que_n$,que_w,que_ptr,que_d$,que_body$
que_n$ = queue_name$
que_d$ = queue_data$
que_w = Val(Mid$(que_n$,1,2))              'extract width
que_ptr = Val(Mid$(que_n$,3,3))            ' pointer to bottom+1
If que_ptr < 256 Then
  If que_ptr = 6 Then
    que_body$ = ""
  Else
    que_body$ = Mid$(que_n$,6,que_ptr - que_w)
  EndIf
  If Len(que_d$) > que_w Then     'check new queue data width
    Print "Error - Data wider than queue width"
    Exit Sub
  Else                              ' right pad if needed
    que_body$ = que_d$ + Space$(que_w - Len(que_d$)) + que_body$
  EndIf
  que_ptr = que_ptr + que_w          ' update pointer and merge all
  que_n$ = Format$(que_w,"%02g") + Format$(que_ptr,"%03g") + que_body$
Else
  Print "Error - Queue overflow"
  Exit Sub
EndIf
queue_name$ = que_n$
End Sub
' Return with queue string updated

' Funtion to pull a value off the front of the queue
' Enter with queue string name
Function S.Queue.Pull$(queue_name$)
Local que_n$,que_w,que_ptr,que_body$
que_n$ = queue_name$
que_w = Val(Mid$(que_n$,1,2))      'extract width
que_ptr = Val(Mid$(que_n$,3,3))    ' pointer to bottom+1

If que_ptr > 6 Then
  que_body$ = Mid$(que_n$,6,que_ptr-que_w - 6)
  S.Queue.Pull$ = Mid$(que_n$,que_ptr - que_w,que_w)
  que_ptr = que_ptr - que_w
  que_n$ = Format$(que_w,"%02g") + Format$(que_ptr,"%03g") + que_body$
Else
  Print "Error - Queue underflow"
  Exit Function
EndIf
queue_name$ = que_n$
End Function
' Return front element of queue

'----------------------------------
'String Manipulation Routines

' Subroutine to overlay a small string onto a larger string at
' a defined starting position in the larger string
' Enter with the larger string as str_name$, str_pos as the
' starting position of the substring to overlay and
' sub_str$ as the overlaying substring. Characters overlayed are lost.

Sub S.Substitute str_name$, str_pos, sub_str$
Local str_n$,str_p,sub_s$,b_str$,a_str$,subst_len
str_n$ = str_name$
str_p = str_pos
sub_s$ = sub_str$
subst_len = Len(sub_s$)
If Len(sub_s$) + str_p > Len(str_n$) Then
  Print "Substring too big to overlay"
  Exit Function
EndIf
b_str$ = Mid$(str_n$,1,str_p)
a_str$ = Mid$(str_n$,str_p+subst_len+1)
str_name$ = b_str$ + sub_s$ + a_str$
End Sub
' Returns with the main string modified.

'---------------------------------------------------------------
'Numeric Stack Manipulation Routines
' - impliments a LIFO push down stack for numeric values within
'   a single string variable using up to 250 character positions
'   in that string. A maximum of 62 numbers can be pushed onto
'   the stack before overflow.
'   The string name is the stack name.

' Subroutine to create an 4 wide stack for numeric variables
' using a single string variable.
' Enter with stk_name$ as the name of the stack
Sub N.Stack.Create stk_name$
Local stk_n$,stk_w
stk_n$ = stk_name$
stk_w = 4
stk_n$=Format$(stk_w,"%02g")+Format$(6,"%03g")
stk_name$ = stk_n$
End Sub
'The string used returns with the stack width in the first 2
' character positions and a pointer to the available next stack
'  entry position in the 3rd 4th and 5th character positions.
' To be used, they need to be converted back to numbers.

' Subroutine to push a new value onto the stack
' Enter with stack string name and value to be pushed
Sub N.Stack.Push stk_name$,stk_data
Local stk_n$,stk_ptr,stk_body$,stk_d$
Local b1,b2,b3,b4,stk_d,stk_w
stk_n$ = stk_name$
stk_d = stk_data
stk_w = 4
NUM2BYTE stk_d,b1,b2,b3,b4
stk_d$=Chr$(b1) + Chr$(b2) + Chr$(b3) + Chr$(b4)
stk_ptr = Val(Mid$(stk_n$,3,3))            ' pointer to bottom+1
If stk_ptr < 256 Then
  If stk_ptr - 6 = 0 Then
    stk_body$ = ""
  Else
    stk_body$ = Mid$(stk_n$,6,stk_ptr-stk_w)
  EndIf
  stk_body$ = stk_d$ + stk_body$
  stk_ptr = stk_ptr+ stk_w          ' update pointer and merge all
  stk_n$ = Format$(stk_w,"%02g") + Format$(stk_ptr,"%03g") + stk_body$
Else
  Print "Error - Stack overflow"
  Exit Sub
EndIf
stk_name$ = stk_n$
End Sub
' Return with stack string updated

' Funtion to pop a value off the top of the stack
' Enter with stack string name
Function N.Stack.Pop(stk_name$)
Local stk_n$,stk_ptr,stk_body$,stk_w
Local b1,b2,b3,b4,stk_d$
stk_w = 4
stk_n$ = stk_name$
stk_ptr = Val(Mid$(stk_n$,3,3))    ' pointer to bottom+1
If stk_ptr => 6 + stk_w Then
  stk_body$ = Mid$(stk_n$,6 + stk_w,stk_ptr-1)
  stk_d$ = Mid$(stk_n$,6,stk_w)
  b1 = Asc(Mid$(stk_d$,1,1))
  b2 = Asc(Mid$(stk_d$,2,1))
  b3 = Asc(Mid$(stk_d$,3,1))
  b4 = Asc(Mid$(stk_d$,4,1))
  N.Stack.Pop = BYTE2NUM(b1,b2,b3,b4)
  stk_ptr = stk_ptr - stk_w
  stk_n$ = Format$(stk_w,"%02g") + Format$(stk_ptr,"%03g") + stk_body$
Else
  Print "Error - Stack underflow"
  Exit Function
EndIf
stk_name$ = stk_n$
End Function
' Return top element of stack

' Funtion to return the average all values on the stack.
' Enter with stack string name
Function N.Stack.Average(stk_name$)
Local stk_n$,stk_ptr,stk_w,stk_cnt
Local b1,b2,b3,b4,stk_d$,stk_av,stk_b
stk_w = 4
stk_av = 0
stk_cnt = 1
stk_b = 6
stk_n$ = stk_name$
stk_ptr = Val(Mid$(stk_n$,3,3))    ' pointer to bottom+1
For stk_b = 6 To stk_ptr - stk_w Step stk_w
  If stk_ptr > stk_b Then
    stk_d$ = Mid$(stk_n$,stk_b,stk_w)
    b1 = Asc(Mid$(stk_d$,1,1))
    b2 = Asc(Mid$(stk_d$,2,1))
    b3 = Asc(Mid$(stk_d$,3,1))
    b4 = Asc(Mid$(stk_d$,4,1))
    stk_av = stk_av + BYTE2NUM(b1,b2,b3,b4)
  EndIf
  N.Stack.Average = (stk_av / stk_cnt)
  stk_cnt = stk_cnt + 1
Next stk_b
End Function
' Return top element of stack


'------------------------------------------------------------------------
' Testing routines
' - test stack creation, push and pop
tst_stk$ = ""
tst_que$ = ""
tst_lst$ = ""

t_stk_w = 5
t_que_w = 5
t_lst_w = 10
t_lst_ptr = 1

tst_data$ = "a"
tst_lst_data_1$ = "Line 1"
tst_lst_data_3$ = "Line 200000"

Cls
? "Firstly, create a stack"
S.Stack.Create tst_stk$,t_stk_w
? "Empty stack = ", tst_stk$
? "...now push some data onto it and pop it off"
S.Stack.Push tst_stk$,tst_data$
? S.Stack.Pop$(tst_stk$)
? "Now fill the stack"
For x = 1 To 50
  S.Stack.Push tst_stk$,Format$(x,"%02g. ") + tst_data$
Next x
? "Full stack string now contains ",tst_stk$
?
? S.Stack.Pop$(tst_stk$)
? S.Stack.Pop$(tst_stk$)
S.Stack.Push tst_stk$,Format$(49,"%02g. ") + tst_data$
S.Stack.Push tst_stk$,Format$(50,"%02g. ") + tst_data$

? "Now test stack overflow "
S.Stack.Push tst_stk$,tst_data$
?
? "Now test stack pop"
? S.Stack.Pop$(tst_stk$)
?
? "Now re-create stack and test for underflow"
S.Stack.Create tst_stk$,t_stk_w
? S.Stack.Pop$(tst_stk$)
?
? "End of stack routines"
Input " .. press any key to continue ",i$
Cls
? "Now for some list tests"
S.List.Create tst_lst$,t_lst_w
? "Empty List string ",tst_lst$
S.List.Add tst_lst$,"1. " + tst_lst_data_1$
? "List string with 1 list added ",tst_lst$
S.List.Add tst_lst$,"2. " + tst_lst_data_1$
? "List string with 2nd list added ",tst_lst$
S.List.Add tst_lst$,tst_lst_data_3$
? "List string with 3rd long list added ",tst_lst$
? ".. now print the first list entry "
? S.List.Get$(tst_lst$,t_lst_ptr)
Input ".. press any key to continue ",i$
Cls
? "Lastly, queue routines"
? "First, create a queue"
S.Queue.Create tst_que$,t_que_w
? "Empty queue = ", tst_que$
? "...now push some data onto it and pull it off"
S.Queue.Push tst_que$,tst_data$
? S.Queue.Pull$(tst_que$)
? "Now fill the queue"
For x = 1 To 50
  S.Queue.Push tst_que$,Format$(x,"%02g. ") + tst_data$
Next x
? "Full queue string now contains ",tst_que$
?
? S.Queue.Pull$(tst_que$)
? S.Queue.Pull$(tst_que$)
S.Queue.Push tst_que$,Format$(49,"%02g. ") + tst_data$
S.Queue.Push tst_que$,Format$(50,"%02g. ") + tst_data$

? "Now test queue overflow "
S.Queue.Push tst_que$,Format$(51,"%02g. ") + tst_data$

?
? "Now test queue pop"
? S.Queue.Pull$(tst_que$)
?
? "Now re-create queue and test for underflow"
S.Queue.Create tst_que$,t_que_w
? S.Queue.Pull$(tst_que$)
?
? "End of string stack, queue and list routines"
Input ".. press any key to continue with numeric tests",i$
Cls
? "Testing Numeric Stack and Queue Routines"
? "Create a stack for use with numbers, push some data"
? "average it then pop it off"
stk_data = 0
N.Stack.Create tst_stk$
N.Stack.Push tst_stk$,4
N.Stack.Push tst_stk$,4
N.Stack.Push tst_stk$,4
N.Stack.Push tst_stk$,4
N.Stack.Push tst_stk$,4
? N.Stack.Average(tst_stk$)
stk_data = N.Stack.Pop(tst_stk$)
stk_data = N.Stack.Pop(tst_stk$)
stk_data = N.Stack.Pop(tst_stk$)
stk_data = N.Stack.Pop(tst_stk$)
stk_data = N.Stack.Pop(tst_stk$)
